perm filename TMP2[0,BGB] blob
sn#112403 filedate 1974-07-19 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 INTEGER PROCEDURE MKFE(INTEGER V1,F,V2)
C00007 ENDMK
C⊗;
INTEGER PROCEDURE MKFE(INTEGER V1,F,V2);
BEGIN
INTEGER V1,F,V2,FNEW,ENEW,E,E0,B,V;
COMMENT MKFE MANDALA
o--------o o--------o
| E2 \ / E1 |
| nccw \ / pcw |
| \ / |
| pvt ⊗ V1 |
| | |
| FNEW ENEW F |
| | |
| nvt ⊗ V2 |
| / \ |
| ncw / \ pccw |
| E3 / \ E4 |
o--------o o--------o ;
FNEW ← MKF(F); ENEW ← MKE(PED(F)); COMMENT CREATE NEW FACE & EDGE;
PED(F) ← PED(FNEW) ← ENEW; COMMENT LINK THE NEW EDGE...;
PFACE(ENEW) ← F; NFACE(ENEW) ← FNEW; COMMENT ...TO ITS FACES;
PVT(ENEW) ← V1; NVT(ENEW) ← V2; COMMENT ...AND TO ITS VERTICES;
COMMENT GET THE UPPER WINGS OF THE NEW EDGE.
E2 ← PED(V1);
DO E2 ← ECW((E1 ← E2),V1) UNTIL FCW(E1,V1) = F;
COMMENT GET THE LOWER WINGS OF THE NEW EDGE.
E2 ← PED(V1);
DO E2 ← ECW((E1 ← E2),V1) UNTIL FCW(E1,V1) = F;
;GET THE LOWER WINGS.
PED E,V2↔DAC E,E0↔DAC E,EDGE0#
L2: LAC E0,E↔SETQ(E,{ECW,E0,V2})
CALL(FCW,E0,V2)↔CAME 1,F↔GO[
CAME E,EDGE0↔GO L2↔FATAL(MKFE - V2 HAS NO WINGS)]
L2A: DAC E0,E3#↔DAC E,E4#
;CDR V2'S TAIL REPLACING F'S WITH FNEW.
E ← E3;
V ← V2
L3: MOVS 1,1(E)↔CAME 1,1(E)↔GO L4
PFACE. FNEW,E
V ← OTHER(E,V);
E ← ECCW(E,V);
GO L3
;CCW FROM V1 REPLACING F'S WITH FNEW.
L4: LAC E0,E↔LAC E,E2↔SETZM A#↔CAMN E0,E2↔GO L6
L5: TESTZ E,WASP↔JSR WASPS
NFACE 0,E↔CAME F,0
GO[PFACE. FNEW,E↔GO .+2]
NFACE. FNEW,E
CAME E,E0
GO[DAC E,A↔SETQ(E,{ECCW,E,FNEW})↔GO L5]
;LINK THE WINGS.
L6: WING(E1,ENEW);
WING(E2,ENEW);
WING(E3,ENEW);
WING(E4,ENEW);
RETURN(ENEW);
END;